Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr48/pas_0593.zip/RB.PAS

Pascal/Delphi Source File | 1993-05-30 | 7KB | 252 lines

{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg  : 389 of 412
From : Steve Gabrilowitz                   1:363/1701.0         15 May 93  21:59
To   : Jeff Carney
Subj : HELP! - File Pos.
────────────────────────────────────────────────────────────────────────────────

In a message to All <05-13-93 02:01> Jeff Carney wrote:

JC>  Can anyone help me figure out how I can move a TEXT file position
JC>  pointer backwards instead of forwards?

I have a little file on my board that purports to read a text file backwards, I
have never tried it but since it's so small I'll just post it here.  The ZIP
contains two files, RB.PAS and TESTRB.PAS.  First, RB.PAS:}

{$R-,S-,I-}

{
 Turbo Pascal 4.0 unit to read text files backwards.

 See TESTRB.PAS for a test and demonstration program. Routines here
 are used in a manner very similar to normal text file read routines
 except that the "reset" positions to the end of the file, and each
 subsequent "readln" returns the prior line in the file until the
 beginning of the file is reached.

 Each string returned by ReadLnBack is in normal forward order.

 One quirk will occur if an attempt is made to read from files with
 lines longer than 255 characters. In this case ReadLnBack will return
 the _last_ 255 characters of each such line rather than the first. This
 is in keeping with the backwards nature of the unit, however.

 Hope someone finds a use for this!

 Written 6/7/88, Kim Kokkonen, TurboPower Software.
 Released to the public domain.
}

unit RB;
  {-Read text files backwards}

interface

type
  BackText = file;                {We use the UserData area in the untyped file

procedure AssignBack(var F : BackText; Fname : string);
  {-Assign a backwards file to a file variable}

procedure ResetBack(var F : BackText; BufSize : Word);
  {-Reset a backwards file, allocating buffer space (128 bytes or greater)}

procedure ReadLnBack(var F : BackText; var S : string);
  {-Read next line from end of backwards file}

procedure CloseBack(var F : BackText);
  {-Close backwards file, releasing buffer}

function BoF(var F : BackText) : Boolean;
  {-Return true when F is positioned at beginning of file}

function BackResult : Word;
  {-Return I/O status code from operation}

  {======================================================================}

implementation

const
  LF = #10;

type
  BufferArray = array[1..65521] of Char;
  BackRec =                       {Same as Dos.FileRec, with UserData filled in
    record
      Handle : Word;
      Mode : Word;
      RecSize : Word;
      Private : array[1..26] of Byte;
      Fpos : LongInt;             {Current file position}
      BufP : ^BufferArray;        {Pointer to text buffer}
      Bpos : Word;                {Current position within buffer}
      Bcnt : Word;                {Count of characters in buffer}
      Bsize : Word;               {Size of text buffer, 0 if none}
      UserData : array[15..16] of Byte; {Remaining UserData}
      Name : array[0..79] of Char;
    end;

var
  BResult : Word;                 {Internal IoResult}

  procedure AssignBack(var F : BackText; Fname : string);
    {-Assign a backwards file to a file variable}
  begin
    if BResult = 0 then begin
      Assign(file(F), Fname);
      BResult := IoResult;
    end;
  end;

  procedure ResetBack(var F : BackText; BufSize : Word);
    {-Reset a backwards file, allocating buffer}
  var
    BR : BackRec absolute F;
  begin
    if BResult = 0 then
      with BR do begin
        {Open file}
        Reset(file(F), 1);
        BResult := IoResult;
        if BResult <> 0 then
          Exit;

        {Seek to end}
        Fpos := FileSize(file(F));
        Seek(file(F), Fpos);
        BResult := IoResult;
        if BResult <> 0 then
          Exit;

        {Allocate buffer}
        if BufSize < 128 then
          BufSize := 128;
        if MaxAvail < BufSize then begin
          BResult := 203;
          Exit;
        end;
        GetMem(BufP, BufSize);
        Bsize := BufSize;
        Bcnt := 0;
        Bpos := 0;
      end;
  end;

  function BoF(var F : BackText) : Boolean;
    {-Return true when F is at beginning of file}
  var
    BR : BackRec absolute F;
  begin
    with BR do
      BoF := (Fpos = 0) and (Bpos = 0);
  end;

  function GetCh(var F : BackText) : Char;
    {-Return next character from end of file}
  var
    BR : BackRec absolute F;
    Bread : Word;
  begin
    with BR do begin
      if Bpos = 0 then
        {Buffer used up}
        if Fpos > 0 then begin
          {Unread file remains, first reposition file pointer}
          Bread := Bsize;
          Dec(Fpos, Bread);
          if Fpos < 0 then begin
            {Reduce the number of characters to read}
            Inc(Bread, Fpos);
            Fpos := 0;
          end;
          Seek(file(F), Fpos);
          BResult := IoResult;
          if BResult <> 0 then
            Exit;

          {Refill buffer}
          BlockRead(file(F), BufP^, Bread, Bcnt);
          BResult := IoResult;
          if BResult <> 0 then
            Exit;

          {Remove ^Z's from end of buffer}
          while (Bcnt > 0) and (BufP^[Bcnt] = ^Z) do
            Dec(Bcnt);
          Bpos := Bcnt;
          if Bpos = 0 then begin
            {At beginning of file}
            GetCh := LF;
            Exit;
          end;

        end else begin
          {At beginning of file}
          GetCh := LF;
          Exit;
        end;

      {Return next character}
      GetCh := BufP^[Bpos];
      Dec(Bpos);
    end;
  end;

  procedure ReadLnBack(var F : BackText; var S : string);
    {-Read next line from end of backwards file}
  var
    Slen : Byte absolute S;
    Tpos : Word;
    Tch : Char;
    T : string;
  begin
    Slen := 0;
    if (BResult = 0) and not BoF(F) then begin
      {Build string from end backwards}
      Tpos := 256;
      repeat
        Tch := GetCh(F);
        if BResult <> 0 then
          Exit;
        if Tpos > 1 then begin
          Dec(Tpos);
          T[Tpos] := Tch;
        end;
        {Note that GetCh arranges to return LF at beginning of file}
      until Tch = LF;
      {Transfer to result string}
      Slen := 255-Tpos;
      if Slen > 0 then
        Move(T[Tpos+1], S[1], Slen);
      {Skip over (presumed) CR}
      Tch := GetCh(F);
    end;
  end;

  procedure CloseBack(var F : BackText);
    {-Close backwards file, releasing buffer}
  var
    BR : BackRec absolute F;
  begin
    if BResult = 0 then
      with BR do begin
        Close(file(F));
        BResult := IoResult;
        if BResult <> 0 then
          Exit;
        FreeMem(BufP, Bsize);
      end;
  end;

  function BackResult : Word;
    {-Return I/O status code from operation}
  begin
    BackResult := BResult;
    BResult := 0;
  end;

begin
  BResult := 0;
end.